perm filename UNDER[POX,WD]2 blob sn#363244 filedate 1978-06-18 generic text, type T, neo UTF8
\|\\;				Define Brick Character
\M0FIX25;\;	fixed font
\⊂'000040;\;	VERREM - REM's syntax form macros with args definitions
\⊂'000400;\;	VERRHT - modified way to pass args with nest chars
\8EVAL(STRING)[⊗STRING⊗]\;
\8OMIT(STRING)[]\;
\8SETOM(REG)[\P\←=1;\→⊗REG⊗\p]\;	set REG to one
\8SETZM(REG)[\P\←=0;\→⊗REG⊗\p]\;	set REG to zero
\8LOADAC(VAR)[\!EVAL((\←=)\!⊗VAR⊗;(;));]\;	load ac with var
\∞TRACEAC[\!EVAL((\m{)(ac=)\D∀( )(}));]\;	trace ac
\;
\8INCR(VAR)[\N			increment variable
\	;\P\N				save ac
\	;\!LOADAC(⊗VAR⊗);\N		load ac with var
\	;\!EVAL((\∂←)⊗VAR⊗(;));\N	expunge old var def
\	;\+=1;\N			add 1 to ac
\	;\!EVAL((\∞)⊗VAR⊗([)\D∀(]));\N
\	;\N				redefine var
\	;\p]\;				restore ac
\;
\8COMPAC(ARG)[\N		complement ac
\	;\!EVAL(⊗ARG⊗);\N		evaluate argument
\	;\Q0\N				save reg 0
\	;\!SETOM(0);\N			put a 1 in reg 0
\	;\?SETZM(0);\N			if ac > 0 set reg 0 to 0
\	;\←0\N				load ac from reg 0
\	;\q0]\;				restore reg 0
\;
\∞ISACZERO[\N			is ac zero
\	;\Q0\N				save qreg 0
\	;\→0\N				store ac in 0
\	;\*0\N				mult ac by qreg 0
\	;\!COMPAC;\N			complement ac
\	;\q0]\;				restore qreg 0
\;
\8LENGTH(STRING)[\N		length of string
\	;\Q0\N				save reg 0
\	;\oSP{0 }\N			put a space in an overlay
\	;\7SP;\N			width of space to ac
\	;\∂←SP;\N			expunge overlay
\	;\→0\N				store ac in reg 0
\	;\oSTR{0 ⊗STRING⊗}\N		put string in overlay
\	;\7STR;\N			width of string to ac
\	;\∂←STR;\N			expunge overlay
\	;\-0\N				subtract off width of space
\	;\/0\N				divide by width of space
\	;\q0]\;				restore reg 0
\;
\8NULL(STRING)[\!COMPAC(\!LENGTH(⊗STRING⊗););]\N
\;
\8FIRST(STRING)[\N		first character of a string
\	;\P\N				save ac
\	;\!OMIT(\a⊗STRING⊗);\N	ascii of 1st char to ac
\	;\N				and flush rest of string
\	;\A∀\N				make char from ac
\	;\p]\;				restore ac
\;
\8REST(STRING)[\N		rest of a string
\	;\P\N				save ac
\	;\a⊗STRING⊗\N			carve off 1st char
\	;\p]\;				restore ac
\;
\8MAPFIRST(MAC,STR)[\N		apply macro to each char of string
\	;\P\N				save ac
\	;\!COMPAC(\!NULL(⊗STR⊗););\N	if string is not null
\	;\?⊗MAC⊗(\?FIRST(⊗STR⊗););\N
\	;\N				apply macro to first char
\	;\?MAPFIRST(⊗MAC⊗,\?REST(⊗STR⊗););\N
\	;\N				apply macro to rest of string
\	;\p]\;				restore ac
\;
\8ISCRLF(CHAR)[\N		is char a cr or lf
\	;\a⊗CHAR⊗\N			ascii of char to ac
\	;\P\N				push ac
\	;\-=13;\N			sub ascii of cr from ac
\	;\!COMPAC(\!ISACZERO;);\N	was it a cr
\	;\?EVAL((\p\N				get back ascii of char
\		;\-=10;\N			sub ascii of lf
\		;\!COMPAC(\!ISACZERO;);));\N	was it a lf
\	;\!COMPAC;]\;			restore pos logic
\;
\8UNDERLINE(STR)[\!MAPFIRST(UNDERLINECHAR,⊗STR⊗);]\;
\;
\8UNDERLINECHAR(CHAR)[\N	underline non crlf chars
\	;\P\N				save ac
\	;\!COMPAC(\!ISCRLF(⊗CHAR⊗););\N	if not cr or lf
\	;\?UNDERLINECHAR1(⊗CHAR⊗);\N	underline it
\	;\!COMPAC;\N			complement ac
\	;\?INCR(UNDCNT);\N
\	;\?EVAL(⊗CHAR⊗);\N		pass bare char
\	;\p]\;				restore ac
\;
\8UNDERLINECHAR1(CHAR)[\[=2;=2;⊗CHAR⊗\]]\;
\8UNDERLINECHAR1(CHAR)[\N	*****
\	;\[=2;=2;⊗CHAR⊗\]\N
\	;\!INCR(UNDCNT);
\!EVAL((\m{)\!UNDCNT;( )(}));]\;
\∞UNDCNT[0]\;		*****
\;
\∞FOO[\N		macro to iterate underline
\	;\-=1;\N		decrement count
\	;\P\N
\	;\!UNDERLINE(a);\N

\	;\p]\;
\←=1000;\;		iteration count
\IFOO;\;
\8PRINTCHARS(STR)[\!MAPFIRST(PRINTCHAR,⊗STR⊗);]\;
\;
\8PRINTCHAR(CH)[
\	;\P\N			save ac
\	;\a⊗CH⊗\N			ascii of char to ac
\	;\!EVAL((\m{)\D∀( )(}));\N	trace ac
\	;\!ISCRLF(⊗CH⊗);\N
\	;\!EVAL((\m{)\D∀( )(}));\N	trace ac
\	;\p]\;			restore ac
\;